home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / asocia1a / filedial.cls < prev    next >
Text File  |  1999-10-22  |  6KB  |  176 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsFileDialog"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' This class use API calls to use the Open and Save common dialog from the "Microsoft Common Dialog Control". This class also adds
  15. ' function to extract filenames when the multiselect is on. It still doesn't have all functions from the dialog control, but all useful
  16. ' functions are included. I will not be held responsible for any damage this could have done to your computer. But if it happens,
  17. ' please tell me right now, I'm always interested in paranormal phenomenons :)
  18.  
  19. ' Made by Insomniaque :)
  20.  
  21. 'modified by Dj's Computer Labs 10/22/99
  22.     'I have not tested the GetMultiFilename function with my changes
  23.     
  24. Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
  25. Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
  26.  
  27. Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
  28. Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
  29.  
  30. Private FileDialog As OPENFILENAME
  31.  
  32. Private Type OPENFILENAME
  33.         lStructSize As Long
  34.         hwndOwner As Long
  35.         hInstance As Long
  36.         lpstrFilter As String
  37.         lpstrCustomFilter As String
  38.         nMaxCustFilter As Long
  39.         nFilterIndex As Long
  40.         lpstrFile As String
  41.         nMaxFile As Long
  42.         lpstrFileTitle As String
  43.         nMaxFileTitle As Long
  44.         lpstrInitialDir As String
  45.         lpstrTitle As String
  46.         Flags As Long
  47.         nFileOffset As Integer
  48.         nFileExtension As Integer
  49.         lpstrDefExt As String
  50.         lCustData As Long
  51.         lpfnHook As Long
  52.         lpTemplateName As String
  53. End Type
  54. Private Sub Class_Initialize()
  55.   With FileDialog
  56.     .hInstance = App.hInstance
  57.     .hwndOwner = hWnd
  58.     .lpstrFile = Chr(0) & Space(254)
  59.     .nMaxFile = 255
  60.     .lStructSize = Len(FileDialog)
  61.   End With
  62. End Sub
  63.  
  64. Public Property Get FilterIndex() As Long
  65.   FilterIndex = FileDialog.nFilterIndex
  66. End Property
  67.  
  68. Public Property Let FilterIndex(ByVal Index As Long)
  69.   FileDialog.nFilterIndex = Index
  70. End Property
  71.  
  72. Public Property Get Flags() As Long
  73.   Flags = FileDialog.Flags
  74. End Property
  75.  
  76. Public Property Let Flags(ByVal vFlags As Long)
  77.   FileDialog.Flags = vFlags
  78. End Property
  79.  
  80. Public Property Let DefaultExtension(ByVal Extention As String)
  81.     ' Default extension for files
  82.     FileDialog.lpstrDefExt = Extention
  83. End Property
  84.  
  85. Public Property Get DefaultExtension() As String
  86.     ' Default extension for files
  87.     DefaultExtension = FileDialog.lpstrDefExt
  88. End Property
  89.  
  90. Public Property Let ObjectOwner(Objet As Object)
  91.     ' Object that 'owns' the common dialog.
  92.     FileDialog.hwndOwner = Objet.hWnd
  93. End Property
  94.  
  95. Public Property Let Filter(ByVal CustomFilter As String)
  96.     ' File filter. Format : "Text for filter|filter|Next Text|Next filter". Ex : "All Files (*.*)|*.*|Text files (*.txt)|*.txt"
  97.     Dim intCount As Integer
  98.     FileDialog.lpstrFilter = ""
  99.     For intCount = 1 To Len(CustomFilter)
  100.         If Mid(CustomFilter, intCount, 1) = "|" Then FileDialog.lpstrFilter = FileDialog.lpstrFilter + Chr(0) Else FileDialog.lpstrFilter = FileDialog.lpstrFilter + Mid(CustomFilter, intCount, 1)
  101.     Next intCount
  102.     FileDialog.lpstrFilter = FileDialog.lpstrFilter + Chr(0)
  103. End Property
  104.  
  105. Public Property Let WindowTitle(ByVal Title As String)
  106.     ' Window title
  107.     FileDialog.lpstrTitle = Title
  108. End Property
  109.  
  110. Public Property Get WindowTitle() As String
  111.     ' Window title
  112.     WindowTitle = FileDialog.lpstrTitle
  113. End Property
  114.  
  115. Public Property Let InitialDirectory(ByVal InitDir As String)
  116.     ' Initial folder
  117.     FileDialog.lpstrInitialDir = InitDir
  118. End Property
  119.  
  120. Public Property Get InitialDirectory() As String
  121.     ' Initial folder
  122.     InitialDirectory = FileDialog.lpstrInitialDir
  123. End Property
  124.  
  125. Public Function FileOpen() As String
  126.   ' Show common dialog open file control and returns file name.
  127.   'Use GetMultiFilename function to  extract filenames when the multiselect flag is true. The Count function returns the number of files selected.
  128.   Dim lngReturn As Long
  129.   
  130.   lngReturn = GetOpenFileName(FileDialog)
  131.   
  132.   If lngReturn >= 1 Then
  133.     FileOpen = FileDialog.lpstrFile
  134.   End If
  135.  
  136. End Function
  137.  
  138. Public Function FileSave() As String
  139.     ' Show common dialog save file control and returns file name.
  140.   Dim lngReturn As Long
  141.   
  142.   lngReturn = GetSaveFileName(FileDialog)
  143.   
  144.   If lngReturn >= 1 Then
  145.     FileSave = FileDialog.lpstrFile
  146.   End If
  147.  
  148. End Function
  149.  
  150. 'Public Function Count() As Integer
  151. '    ' Returns the number of file selected. Use with GetMultiFilename to extract filename when multiselect is true.
  152. '    Dim intCount As Integer
  153. '    For intCount = 1 To Trim(Len(FileDialog.lpstrFile))
  154. '        If Mid(Trim(FileDialog.lpstrFile), intCount, 1) = Chr(0) Then Count = Count + 1
  155. '    Next intCount
  156. '    Count = Count - 2
  157. '    If Count < 1 Then Count = Count + 1
  158. 'End Function
  159. '
  160. 'Public Function GetMultiFilename(ByVal Filenumber As Integer) As String
  161. '    ' Returns the filename of the specified filenumber. Use only with open file dialog when multiselect is true.
  162. '    Dim intCount As Integer
  163. '    Dim intOne As Integer
  164. '    Dim intFile As Integer
  165. '    Dim intNext As Integer
  166. '    intOne = InStr(1, Trim(FileDialog.lpstrFile), Chr(0))
  167. '    intFile = 1
  168. '    For intCount = 1 To Filenumber
  169. '        intFile = InStr(intFile + 1, Trim(FileDialog.lpstrFile), Chr(0))
  170. '    Next intCount
  171. '    intNext = InStr(intFile + 1, Trim(FileDialog.lpstrFile), Chr(0))
  172. '    GetMultiFilename = IIf(Right(Mid(Trim(FileDialog.lpstrFile), 1, intOne - 1), 1) = "\", Mid(Trim(FileDialog.lpstrFile), 1, intOne - 1), Mid(Trim(FileDialog.lpstrFile), 1, intOne - 1) + "\") + Mid(Trim(FileDialog.lpstrFile), intFile + 1, intNext - intFile - 1)
  173. '    If Right(GetMultiFilename, 1) = "\" Then GetMultiFilename = Left(GetMultiFilename, Len(GetMultiFilename) - 1)
  174. 'End Function
  175.  
  176.